Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / k11rtd.mac < prev next >

Wrap

Text File | 1989-06-12 | 23.7 KB | 896 lines

.title k11rtd wildcard directory lookup for RT11 .ident /2.17/ ; 18-Jun-84 16:33:01 Brian Nelson ; ; ; Copyright (C) 1984 Change Software, Inc ; ; 17-Sep-86 13:23:00 Handle Labels stuffed in by VMS Exchange ; Include things we want for kermit .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .iif ndf, k11inc, .error ; .INCLUDE failed .psect .enabl gbl .sbttl local data offsets and definitions .mcall .csispc ,.dstat ,.fetch ,.lookup,.readw ,.close ,.cstat .mcall .serr ,.herr ,.purge topmem = 50 errbyt = 52 DEV$LD = 46 ;/45/ LD: identification tent = 400 ; status for a tentative file empty = 1000 ; status for an empty entry perm = 2000 ; status bit for a permanent file endseg = 4000 ; end of a segment bits ;; star = 134745 ; from .csispc for a '*' (rt11/rsts) star = 132500 ; from .csispc for a '*' (real RT11) .psect rtdir ,rw,d,lcl,rel,con hd$blk = 1 ; vbn of the home block hd$fir = 724 ; offset into home block for first block hd$vol = 730 ; RT11A and seven spaces usually hd$sys = 760 ; always DECRT11A outlun: .word 0 dirbuf: .blkb 2000 ; 2 block buffer for directory segments name1: .blkb 12 name2: .blkb 12 .save .psect rtdir1 ,rw,d,gbl,rel,con contex: .word 0 ; current file number hd.fir: .word 0 ; block number of first entry itsopen:.word 0 time: .word 0,45 devtyp: .word 0 .restore junk: .blkb 20 ; information from the directory header h$nseg = 0 ; offset for segment count in buffer h$next = 2 ; offset for next block link h$max = 4 ; offset for highest segment in use h$ext = 6 ; offset for number of extra words h$blk = 10 ; offset for first block # of data h.nseg: .blkw 1 ; number of segments in the directory h.next: .blkw 1 ; link to the next directory segment h.max: .blkw 1 ; max segment actually in use h.ext: .blkw 1 ; number of extra words per entry h.blk: .blkw 1 ; data block number for the segment ; information from the current directoty entry f.stat = 0 ; entry status word f.nam = 2 ; all three words of the name+type f.nam1 = 2 ; first three rad50 characters of name f.nam2 = 4 ; last three rad50 characters of name f.type = 6 ; all three rad50 characters of type f.len = 10 ; file size f.misc = 12 ; we don't care about this stuff f.date = 14 ; creation date .save .psect rtdir1 ,rw,d,gbl,rel,con loklen: .word 0 ;/38/ added for server lokdate:.word 0 ;/38/ added for server dirsiz: .blkw 1 ; total size of a directory entry filnam: .blkw 4 ; the .csispc parsed filename+type resnam: .blkw 4 ; the name we found .restore .psect .psect $code lookup::save <r1,r2,r3> ; save all the temps please copyz 2(r5) ,6(r5) ; return the passed name for starters tst nowild ;/51/ Perhaps send a DEVICE? beq 30$ ;/51/ No clr r0 ;/51/ Assume success tst @4(r5) ;/51/ Second time for sending device? beq 20$ ;/51/ No mov #ER$NMF ,r0 ;/51/ Yes, br 100$ all done br 100$ ;/51/ Exit 20$: inc @4(r5) ;/51/ Success, increment context. br 100$ ;/51/ Exit 30$: tst @4(r5) ; new call sequence today? bne 40$ ; no clr context ; yes, flag so clr h.max ; also init a flag .close #lun.sr ; close the old device up also clr r0 ; no errors please clr itsopen ; device is no longer open 40$: tst itsopen ; need to open it up bne 50$ ; no, already established a context call opndev ; get the disk opened up please tst r0 ; any errors ? bne 100$ ; yes, we will have to die then mov sp ,itsopen ; device is open for next call 50$: call getnth ; lookup the next one please tst r0 ; errors ? bne 90$ ; no inc @4(r5) ; return correct context br 100$ 90$: push r0 ; yes, close the device please .close #lun.sr ; close the device up on errors clr context ; insure current context is cleared clr itsopen ; insure we do an open next time pop r0 ; restore the error code now 100$: unsave <r3,r2,r1> ; pop temps and exit please return ; return any errors in r0 .sbttl print directory listing ; D O D I R ; ; input: @r5 wildcarded filespec ; output: r0 error code ; ; DODIR prints a directory listing at the local terminal. ; ; ; S D O D I R ; ; Passed: @r5 wildcarded name ; Return: r0 error code, zero for no errors ; r1 next character in the directory listing ; ; SDODIR is called by the server to respond to a remote directory ; command. Instead of the pre 2.38 method of dumping output to a ; disk file and then sending the disk file in an extended replay, ; SDODIR returns the next character so that BUFFIL can use it. ; The routine GETCR0 is actually a dispatch routine to call the ; currently selected GET_NEXT_CHARACTER routine. .save .psect dirmap ,rw,d,gbl,rel,ovr dirnam: .blkw 1 ;/51/ Filled in at startup dirbfr: .blkw 1 ;/51/ Ditto .psect rtdir1 ,rw,d,gbl,rel,con diridx: .word 0 dirptr: .word 0 wild: .asciz /*.*/ dspace: .byte 40,0 dcrlf: .byte 15,12,0 .even .restore dodir:: save <r1,r2,r3,r5> ; save these please mov 2(r5) ,outlun 10$: mov @r5 ,-(sp) mov #1 ,-(sp) mov sp ,r5 call .dodir cmp (sp)+ ,(sp)+ 100$: unsave <r5,r3,r2,r1> clr r0 return .dodir: tst itsopen ; need to open it up beq 10$ ; yes .close #lun.sr ; please close up shop first clr itsopen ; say it's closed now 10$: call opndev ; get the disk opened up please tst r0 ; any errors ? bne 100$ ; yes, we will have to die then mov sp ,itsopen ; device is open for next call 50$: call pridir ; lookup the next one please tst r0 ; errors ? beq 50$ ; no 90$: mov r0 ,-(sp) ; yes, close the device please .close #lun.sr ; close the device up on errors clr itsopen ; insure we do an open next time mov (sp)+ ,r0 ; restore the error code now 100$: return ; return any errors in r0 .sbttl SDODIR directoty stuff for a server sdirin::strcpy dirnam ,@r5 ; copy name over mov dirbfr ,dirptr ; yes, init pointers please clr diridx ; ditto call dirini ; init for calls to sdodir bcs 100$ mov dirbfr ,dirptr ; yes, init pointers please clrb @dirptr ; yes, zap the buffer call dirnex ; preload buffer 100$: return sdodir::save <r2,r3,r4> 10$: movb @dirptr ,r1 ; get the next character please bne 20$ ; something was there mov dirbfr ,dirptr ; reset the pointer clrb @dirptr ; yes, zap the buffer call dirnex ; empty buffer, load with next file bcs 90$ ; no more, return ER$EOF br 10$ ; and try again 20$: inc dirptr ; pointer++ clr r0 ; no errors br 100$ ; exit 90$: mov #ER$EOF ,r0 ; failure, return(EOF) 95$: clr r1 ; return no data also clr diridx ; init for next time through 100$: unsave <r4,r3,r2> return dirini: clr diridx ; clear context flag mov dirbfr ,dirptr ; set pointer up for SDODIR clrb @dirptr ; clear buffer return ; thats all folks dirnex: movb defdir ,-(sp) ; anything in DEFDIR ? bne 10$ ; yes, don't alter it please strcpy #defdir ,#wild ; nothing, insert *.*;* 10$: mov dirbfr ,r2 ; pointer to buffer mov #junk ,r3 ; pointer to work buffer calls lookup ,<#3,dirnam,#diridx,r2> tst r0 ; successfull? bne 80$ ; no strlen r2 ; get the length of the string mov #20 ,r1 ; and format the string sub r0 ,r1 ; number of spaces to append ble 30$ ; can't happen 20$: strcat r2 ,#dspace ; append spaces please sob r1 ,20$ ; next please 30$: deccvt loklen ,r3 ; filesize clrb 6(r3) ; insure .asciz please strcat r2 ,r3 ; append it please strcat r2 ,#dspace ; a space mov lokdate ,r0 ; get date converted bne 40$ ; valid dec r0 ; invalid, force 00-xxx-00 40$: calls cvtdat ,<r3,r0>,nogbl ; append the date please strcat r2 ,r3 ; strcat r2 ,#dcrlf ; yes, append <cr><lf> clr r0 ; success br 100$ ; exit 80$: cmp r0 ,#ER$NMF ; no more files error ? bne 90$ ; no tst diridx ; ever do anything? bne 90$ ; yes mov #ER$FNF ,r0 ; no, convert to file not found 90$: sec 100$: movb (sp)+ ,defdir ; restore DEFDIR return .sbttl open the disk up to search the directory opndev: .SERR ;/51/ Trap fatal errors please sub #20. ,sp ; allocate buffer for the mov sp ,r2 ; device status call sub #40.*2 ,sp ; allocate a buffer for the mov sp ,r1 ; .csispc data 1$: mov #defdir ,r3 ; insert default device name scan #': ,2(r5) ; check for a device already there tst r0 ; well ? bne 6$ ; yep. don't try to put one in please 5$: movb (r3)+ ,@r1 ; copy it beq 6$ ; all done inc r1 ; not null, next please br 5$ ; 6$: mov 2(r5) ,r0 ; string address 10$: movb (r0)+ ,(r1)+ ; copy it to the csi buffer bne 10$ ; until a null byte is found. dec r1 ; get back to the last character cmpb -1(r1) ,#': ; is the just just a device only? bne 15$ ; no movb #'* ,(r1)+ ; yes, insert *.* movb #'. ,(r1)+ ; yes, insert *.* movb #'* ,(r1)+ ; yes, insert *.* 15$: movb #'= ,(r1)+ ; fake an output filespec here clrb @r1 ; and .asciz mov sp ,r1 ; reset pointer (also saving sp) .csispc r1,#defext,r1 ; and try to parse the name mov r1 ,sp ; restore from any switches bcs 80$ ; oops calls fetch ,<@r1> ; try to get the thing loaded tst r0 ; well ? bne 120$ ; no, exit with mapped error mov devidx ,devtyp ;/45/ Save device type from .FETCH 20$: tst @r1 ; a specific device name ? bne 30$ ; yes mov #^RDK ,@r1 ; no, stuff DK: into it then 30$: mov r1 ,r0 ; copy the pointer to .csispc results mov #filnam ,r2 ; and save the results mov (r0)+ ,(r2)+ ; copy the device spec first of all mov @r0 ,(r2)+ ; copy the first 3 rad50 of filename bne 40$ ; something was indeed there mov #star ,-2(r2) ; nothing, convert to wilcard 40$: clr (r0)+ ; and clear any filenames please mov @r0 ,(r2)+ ; copy the last 3 rad50 of filename clr (r0)+ ; and clear any filenames please mov @r0 ,(r2)+ ; copy the 3 rad50 of filetype .if eq,-1 ;/58/ not longer implied wildcard here bne 50$ ; something was passed for filetype mov #star ,-2(r2) ; nothing there, stuff a wilcard in .endc 50$: clr (r0)+ ; and clear any filetypes please clr (r0)+ ; to be sure .lookup #rtwork,#lun.sr,r1 ; open the file for input bcs 100$ ; can not find it clr r0 ; no errors br 120$ ; and exit 60$: mov #dsterr ,r1 br 110$ 80$: mov #csierr ,r1 ; .csispc error mapping br 110$ ; get the correct error now 90$: mov #feterr ,r1 ; .fetch error codes br 110$ 100$: mov #lokerr ,r1 ; .lookup error mapping br 110$ 110$: movb @#errbyt,r0 ; get the error code now bpl 115$ ;/51/ Normal RT11 error com r0 ;/51/ Make positive add #faterr ,r0 ;/51/ Map to fatal error list 115$: asl r0 ; times 2 for indexing into error map add r0 ,r1 ; now map the rt11 error into a fake mov @r1 ,r0 ; of a rms11 error 120$: add #<40.*2>+20.,sp ; pop all the tiny buffers now. push r0 ;/51/ Successfull? beq 130$ ;/51/ Yes .PURGE #LUN.SR ;/51/ No, purge the channel now 130$: .HERR ;/51/ Restore normal error control pop r0 ;/51/ Pop actual error code return ; and get out .save .psect rtdir defext: .word star,star,star,star ;/58/ default ext. are wildcards .restore .sbttl read the home block in please gethom: save <r1,r2> ;/54/ .readw #rtwork,#lun.sr,#dirbuf,#400,#hd$blk bcs 90$ ; it failed, bye mov #dirbuf ,r2 ; point to the buffer now mov hd$fir(r2),hd.fir ; get the first directory block number bne 5$ ; /56/ mov #6 ,hd.fir ; /56/ Disk had no init data 5$: add #hd$sys ,r2 ; point to the volume ident cmpb devtyp ,#DEV$LD ;/45/ Logical disk ? beq 30$ ;/45/ Yes, skip the check tst rtvol ; really verify volume ? beq 30$ ; no mov r2 ,r1 ;/54/ Check mov #rt ,r0 ;/54/ ... 10$: tstb @r0 ;/54/ Done beq 30$ ;/54/ Yes, exit cmpb (r0)+ ,(r1)+ ;/54/ Same beq 10$ ;/54/ Yes, keep looking mov r2 ,r1 ;/54/ Check mov #vms ,r0 ;/54/ ... 20$: tstb @r0 ;/54/ Done beq 30$ ;/54/ Yes, exit cmpb (r0)+ ,(r1)+ ;/54/ Same beq 20$ ;/54/ Yes, keep looking br 80$ ;/54/ Not valid 30$: clr r0 ; no errors br 100$ ; and exit 80$: mov #er$vol ,r0 ; return an error code and exit br 100$ ; bye 90$: movb @#errbyt,r0 ; get the error code asl r0 ; times two mov reaerr(r0),r0 ; map it into a unique global error 100$: unsave <r2,r1> ;/54/ return ; bye .save ;/54/ .psect $PDATA D ;/54/ rt: .asciz /DECRT11/ ;/54/ vms: .asciz /DECVMSEX/ ;/54/ From EXCHANGE under VMS4.x .even ;/54/ .restore ;/54/ gethdr: .readw #rtwork,#lun.sr,#dirbuf,#1000,r1 bcs 90$ ; it failed, bye mov #dirbuf ,r0 ; point to the buffer now mov h$nseg(r0),h.nseg ; get the total segment count now asl h$next(r0) ; segments are two blocks in length beq 5$ ; no more segments if zero add #4 ,h$next(r0) ; and at last, the offset 5$: mov h$next(r0),h.next ; get the link to the next one tst h.max ; already set up ? bne 10$ ; yes, don't touch it please mov h$max(r0) ,h.max ; get the maximum segment in use 10$: mov h$ext(r0) ,h.ext ; get the extra words per dir entry mov h$blk(r0) ,h.blk ; and the starting block for data mov #7*2 ,dirsiz ; the default entry size add h$ext(r0),dirsiz ; plus extra bytes per entry clr r0 ; no errors br 100$ ; and exit 90$: movb @#errbyt,r0 ; get the error code asl r0 ; times two mov reaerr(r0),r0 ; map it into a unique global error 100$: return ; bye global <rtvol> .sbttl print the directory out pridir: save <r1,r2,r3> ; save temps call gethom ; read in the home block tst r0 ; did it work ? bne 100$ ; no, exit with the error please mov hd.fir ,r1 ; get this directory entry 10$: tst r1 ; end of the directory list ? beq 90$ ; yes, return 'no more files' please call gethdr ; the the first directory header tst r0 ; did this work out ? bne 100$ ; no, return mapped error code please mov #dirbuf ,r3 ; point to the directory buffer add #5*2 ,r3 ; skip past the header information 20$: bit #endseg ,f.stat(r3) ; end of this segment ? bne 80$ ; yes, try the next one please bit #perm ,f.stat(r3) ; is this a real file ? beq 70$ ; no, skip it please call match ; see if the file matches up tst r0 ; well ? beq 70$ ; no, try again please mov #junk ,r2 ; a local buffer to use call convert ; convert to asciz mov #junk ,-(sp) ; push the buffer address call 110$ ; dump it please deccvt f.len(r3),#junk ; convert size to decimal clrb junk+6 ; insure .asciz please mov #junk ,-(sp) ; push the buffer address call 110$ ; and do it mov #210$ ,-(sp) ; push buffer call 110$ ; dump it mov f.date(r3),r0 ; a real date today? bne 60$ ; yes dec r0 ; no, force 00-xxx-00 60$: calls cvtdat ,<#junk,r0>,nogbl; and convert the date mov #junk ,-(sp) ; same again call 110$ ; mov #200$ ,-(sp) ; call 110$ ; 70$: add dirsiz ,r3 ; skip to the next entry please br 20$ ; and check this one out please 80$: mov h.next ,r1 ; end of segment, check the next one br 10$ ; simple to do 90$: mov #er$nmf ,r0 100$: unsave <r3,r2,r1> ; pop temps and exit return 110$: save <r0,r1,r2,r3> ; save registers mov 12(sp) ,r3 ; get the buffer address tst outlun ; output to disk or terminal beq 150$ ; tt: strlen r3 ; disk, get the buffer size mov r0 ,r2 ; save it please beq 190$ ; nothing to do 120$: movb (r3)+ ,r0 ; get the next character mov outlun ,r1 ; set the lun up also call putcr0 ; dump the character sob r2 ,120$ ; and get the next one br 190$ ; exit 150$: .print r3 ; output to tt: 190$: unsave <r3,r2,r1,r0> ; pop registers and exit mov (sp)+ ,(sp) ; move return address up and exit return ; bye 200$: .byte 15,12,0 210$: .byte 40,40,40,0 .even .sbttl get the next entry matching a possibly wildcarded name getnth: save <r1,r2,r3,r4> ; save temps clr r4 ; counter for number of matches call gethom ; read in the home block tst r0 ; did it work ? bne 100$ ; no, exit with the error please mov hd.fir ,r1 ; get this directory entry 10$: tst r1 ; end of the directory list ? beq 90$ ; yes, return 'no more files' please call gethdr ; the the first directory header tst r0 ; did this work out ? bne 100$ ; no, return mapped error code please mov #dirbuf ,r3 ; point to the directory buffer add #5*2 ,r3 ; skip past the header information 20$: bit #endseg ,f.stat(r3) ; end of this segment ? bne 80$ ; yes, try the next one please bit #perm ,f.stat(r3) ; is this a real file ? beq 70$ ; no, skip it please call match ; see if the file matches up tst r0 ; well ? beq 70$ ; no, try again please cmp r4 ,context ; a match here ? bne 50$ ; no, try again please mov 6(r5) ,r2 ; a buffer to convert into call convert ; convert to asciz mov r2 ,r0 ; not get rid off ALL spaces in the name 30$: tstb @r0 ; end of the string yet ? beq 40$ ; yes cmpb @r0 ,#40 ; if it's a space, then ignore it beq 35$ ; skip it please movb @r0 ,(r2)+ ; not a space, please copy it then 35$: inc r0 ; point to the next character now br 30$ ; and check the next character please 40$: clrb @r2 ; insure returned string is .asciz mov F.DATE(r3),lokdate ;/38/ save this mov F.LEN(r3),loklen ;/38/ save this clr r0 ; success inc context ; next one next time please br 100$ ; bye 50$: inc r4 ; matches := succ( matches ) br 70$ ; next try please 70$: add dirsiz ,r3 ; skip to the next entry please br 20$ ; and check this one out please 80$: mov h.next ,r1 ; end of segment, check the next one br 10$ ; simple to do 90$: mov #er$nmf ,r0 100$: unsave <r4,r3,r2,r1> ; pop temps and exit return .sbttl convert current directory entry to asciz ; input: r2 buffer for the result ; r3 current directory entry pointer convert:mov r2 ,-(sp) ; save the passed pointer to a buffer calls rdtoa ,<r2,filnam> ; convert the device name please cmpb @r2 ,#40 ; a space for device name ? bne 10$ ; no movb #'D&137 ,@r2 ; yes, stuff 'DK' in please movb #'K&137 ,1(r2) ; simple to do 10$: add #2 ,r2 ; skip past it and insert a ':' cmpb @r2 ,#40 ; a space (no unit number?) beq 20$ ; no tstb (r2)+ ; a real unit, skip over number 20$: movb #': ,(r2)+ ; yes, get DD: format of device name calls rdtoa ,<r2,f.nam1(r3)>; convert first 3 filename to ascii add #3 ,r2 ; and skip over those three characters calls rdtoa ,<r2,f.nam2(r3)>; now get the rest of the filename add #3 ,r2 ; point to place a dot into the name movb #'. ,(r2)+ ; a dot calls rdtoa ,<r2,f.type(r3)>; get the filetype at last clrb 3(r2) ; and insure .asciz please mov (sp)+ ,r2 ; pop the pointer and exit return ; bye .enabl lsb percent = '. ;/58/ percent in a filspc string wildc = '? ;/58/ wildcard flag match: save <r1,r2> ; we may need these here mov filnam+2,rtwork+0 ; copy the name and type please mov filnam+4,rtwork+2 ; copy the name and type please mov filnam+6,rtwork+4 ; copy the name and type please mov #name1 ,r1 ; was not a simple pattern so convert mov #rtwork ,r2 ; both names back to ascii and check mov #3 ,r0 ; for individual character wildcarding 40$: calls rdtoa ,<r1,(r2)+> ; convert the patter filename back add #3 ,r1 ; increment the pointer by 3 char's. sob r0 ,40$ ; next please ; mov #name2 ,r1 ; a buffer for the file we just found mov r3 ,r2 ; on the disk. Now get the address of add #f.nam1 ,r2 ; the name and filetype, convert this mov #3 ,r0 ; to ascii in a loop 50$: calls rdtoa ,<r1,(r2)+> ; convert add #3 ,r1 ; next please sob r0 ,50$ ; ; 60$: mov #name1 ,r1 ; the filename pattern mov #name2 ,r2 ; the current filename on disk mov #6. ,r0 ; the loop count for scanning call 200$ ;/58/ compare filename bcs 90$ ;/58/ /B on match failure mov #name1+6,r1 ; the filetype pattern mov #name2+6,r2 ; the current filetype on disk mov #3. ,r0 ; the loop count for scanning call 200$ ;/58/ compare filetype bcs 90$ ;/58/ /B on match failure mov sp ,r0 ; flag success and exit br 100$ ; bye ; 90$: clr r0 ; failure, exit ; 100$: unsave <r2,r1> ; restore registers return ; and exit at last ; 200$: mov r0 ,311$ ;/58/ save for later re-use mov r1 ,310$ ;/58/ 201$: cmpb @r1 ,@r2 ;/58/ if they match, no problem beq 202$ ;/58/ simply check the next character cmpb @r1 ,#wildc ;/58/ a translated "* wildcard ? beq 210$ ;/58/ yes - alternativ check cmpb @r1 ,#percent ;/58/ a translated "% wildcard ? bne 231$ ;/58/ no - match failure ... 202$: inc r1 ;/58/ match so far, inc r2 ;/58/ update pointers sob r0 ,201$ ;/58/ and check the next ones call 300$ ;/58/ are we at end of string? bcs 230$ ;/58/ yes - success cmpb @r1 ,#space ;/58/ no - see if wildcarded beq 230$ ;/58/ if so, success br 231$ ;/58/ else failure ... ;/58/ 210$: inc r1 ;/58/ point to char. after wildc call 300$ ;/58/ are we at end of string? bcs 230$ ;/58/ if so, success ... 211$: cmpb @r1 ,#space ;/58/ a spaces? beq 230$ ;/58/ end of matching check cmpb @r1 ,#percent ;/58/ a translated "% wildcard ? bne 220$ ;/58/ no - compare strings inc r1 ;/58/ point to char. after wildc sob r0,211$ ;/58/ otherwise loop to find a char. br 230$ ;/58/ all "%'s - assume success ;/58/ 220$: cmpb @r1 ,@r2 ;/58/ find a matching character bne 221$ ;/58/ not yet, see next ... cmpb 1(r2) ,@r2 ;/58/ next = same? bne 202$ ;/58/ no - verify remainder 221$: inc r2 ;/58/ else point to next sob r0,220$ ;/58/ and loop until done br 231$ ;/58/ match failure ;/58/ 230$: tst (pc)+ ;/58/ bump next instr. and clr carry 231$: sec ;/58/ flag failure return ;/58/ back to caller ;/58/ 300$: push r0 ;/58/ save temp mov r1 ,r0 ;/58/ copy searched string pointer sub (pc)+ ,r0 ;/58/ make match count 310$: .word 0 ;/58/ searched string base address cmp (pc)+ ,r0 ;/58/ compare with char. count 311$: .word 0 ;/58/ string width beq 320$ ;/58/ yes - flag end string tst (pc)+ ;/58/ else skip next instr. 320$: sec ;/58/ flag end-of-string pop r0 ;/58/ restore reg return .dsabl lsb .sbttl ascdat convert to ascii date for RT11 .mcall .date ; input: @r5 output buffer address ; 2(r5) value of date, zero implies current ; ; I certainly could use my ASH and DIV macros, but may as ; well do it this way for future possibilities. ; ; N O T E : This is a LOCAL copy of ASCDAT so I can overlay ; the real ACSDAT oppossing this overlay. cvtdat: save <r0,r1,r2,r3> ; save these please mov @r5 ,r1 ; the result address cmp 2(r5) ,#-1 ; if -1, then return 00-XXX-00 bne 5$ ; no copyz #310$ ,r1 ; yes, then exit br 100$ ; bye 5$: mov 2(r5) ,r0 ; get the date desired please bne 10$ ; it's ok .date ; zero, assume todays date then 10$: bic #100000 ,r0 ; undefined mov r0 ,r3 ; copy the date asr r3 ;/2 asr r3 ;/2 again asr r3 ; ditto asr r3 ; sigh asr r3 ; at last bic #^C37 ,r3 ; the date, at last call 200$ ; convert it mov r0 ,r3 ; get the date once again please swab r3 ; get the month to bits 2..7 asr r3 ;/2 asr r3 ;/2 again bic #^C17 ,r3 ; get rid of the unwanted bits now dec r3 ; convert to 0..11 asl r3 ; convert to word offset asl r3 ; quad offset add #300$ ,r3 ; the address of the text movb #'- ,(r1)+ ; copy it over please movb (r3)+ ,(r1)+ ; three characters please movb (r3)+ ,(r1)+ ; three characters please movb (r3)+ ,(r1)+ ; three characters please movb #'- ,(r1)+ ; copy it over please mov r0 ,r3 ; copy the date bic #^C37 ,r3 ; the year, at last add #110 ,r3 ; plus the bias please call 200$ ; convert clrb @r1 ; .asciz and exit 100$: unsave <r3,r2,r1,r0> return 200$: clr r2 ; subtract 10 a few times 210$: inc r2 ; high digit number sub #12 ,r3 ; until we get a negative number tst r3 ; done yet ? bge 210$ ; no dec r2 ; yes add #12 ,r3 ; correct it please add #'0 ,r2 ; and copy the day number please add #'0 ,r3 ; simple movb r2 ,(r1)+ ; copy it movb r3 ,(r1)+ ; copy it return .nlist bex 300$: .ascii /Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec / 310$: .asciz /00-XXX-00/ .list bex .even .end